home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #067 (1990-04)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #067 (1990-04)(Amiga User Group Deutschland e.V.).adf / Source.zip / Declarations.p < prev    next >
Text File  |  1990-01-26  |  17KB  |  724 lines

  1. External;
  2.  
  3. {
  4.     Declarations.p (of PCQ Pascal)
  5.     Copyright (c) 1989 Patrick Quaid
  6.  
  7.     Generally speaking, this module handles the various
  8. declarations.  The major exception to this is doblock(), in main.p,
  9. which might be considered a declaration.
  10. }
  11.  
  12. {$O-}
  13. {$I "Pascal.i"}
  14.  
  15.     Function EnterStandard(    st_Name : String;
  16.                 st_Object : IDObject;
  17.                 st_Type : TypePtr;
  18.                 st_Storage : IDStorage;
  19.                 st_Offset : Integer) : IDPtr;
  20.         external;
  21.     Function EnterSpell(Str : String) : String;
  22.         external;
  23.     Function Match(i : Symbols): boolean;
  24.         external;
  25.     Procedure Error(s : string);
  26.         external;
  27.     Function ConExpr(VAR ConType : TypePtr): Integer;
  28.         external;
  29.     Function AddType(at_Object : TypeObject;
  30.              at_SubType : TypePtr;
  31.              at_Ref : Address;
  32.              at_Upper,
  33.              at_Lower,
  34.              at_Size : Integer) : TypePtr;
  35.         external;
  36.  
  37.     procedure ns;
  38.         external;
  39.     Function TypeCmp(f, s : TypePtr): Boolean;
  40.         external;
  41.     Function FindID(s: string): IDPtr;
  42.         external;
  43.     function CheckID(s : string): IDPtr;
  44.         external;
  45.     Function CheckIDList(s : String; ID : IDPtr) : Boolean;
  46.         external;
  47.     Procedure EnterID(EntryBlock : BlockPtr; ID : IDPtr);
  48.         external;
  49.     procedure NextSymbol;
  50.         external;
  51.     Procedure NeedLeftParent;
  52.         External;
  53.     procedure NeedRightParent;
  54.         external;
  55.     Procedure Mismatch;
  56.         External;
  57.     Procedure DumpLitQ(Start : Integer);
  58.         External;
  59.     Procedure WriteHex(num : Integer);
  60.         External;
  61.     Function Suffix(Size : Integer) : Char;
  62.         External;
  63.     Function TypeCheck(T1, T2 : TypePtr) : Boolean;
  64.         External;
  65.     Procedure PrintLabel(Lab : Integer);
  66.         External;
  67.     Function GetLabel : Integer;
  68.         External;
  69.  
  70. Function DeclVar(ob : IDObject) : IDPtr;
  71.     forward;
  72.  
  73. Procedure ReformArgs(ProcID : IDPtr);
  74.  
  75. {
  76.     This is the first in a series of routines that assigns the
  77. proper addresses to procedure or function arguments.
  78. }
  79.  
  80. var
  81.     TotalSize    : Integer;
  82.     ID        : IDPtr;
  83. begin
  84.     ID := ProcID^.Param;
  85.     if ProcID^.Level = 1 then
  86.     TotalSize := 8
  87.     else
  88.     TotalSize := 12;
  89.     While ID <> Nil do begin
  90.     if ID^.Object = ValArg then begin
  91.         TotalSize := TotalSize + ID^.VType^.Size;
  92.         if Odd(TotalSize) then
  93.         TotalSize := Succ(TotalSize);
  94.     end else
  95.         TotalSize := TotalSize + 4;
  96.     ID := ID^.Next;
  97.     end;
  98.     ID := ProcID^.Param;
  99.     while ID <> Nil do begin
  100.     if ID^.Object = ValArg then begin
  101.         TotalSize := TotalSize - ID^.VType^.Size;
  102.         if Odd(TotalSize) then begin
  103.         if ID^.VType^.Size = 1 then begin
  104.             ID^.Offset := TotalSize;
  105.             TotalSize := Pred(TotalSize);
  106.         end else begin
  107.             TotalSize := Pred(TotalSize);
  108.             ID^.Offset := TotalSize;
  109.         end;
  110.         end else
  111.         ID^.Offset := TotalSize;
  112.     end else begin { RefArg }
  113.         TotalSize := TotalSize - 4;
  114.         ID^.Offset := TotalSize;
  115.     end;
  116.     ID := ID^.Next;
  117.     end;
  118. end;
  119.  
  120. Function ReformFields(ID : IDPtr) : Integer;
  121.  
  122. {
  123.     ...Determines the proper offsets of the fields, and returns the
  124. total size of the record.
  125. }
  126. var
  127.     TotalSize : Integer;
  128. begin
  129.     TotalSize := 0;
  130.     while ID <> Nil do begin
  131.     if Odd(TotalSize) and (ID^.VType^.Size <> 1) then
  132.         TotalSize := Succ(TotalSize);
  133.     ID^.Offset := TotalSize;
  134.     TotalSize := TotalSize + ID^.VType^.Size;
  135.     ID := ID^.Next;
  136.     end;
  137.     ReformFields := TotalSize;
  138. end;
  139.  
  140. Function GetRange() : TypePtr;
  141. var
  142.     TP        : TypePtr;
  143.     IndexType1,
  144.     IndexType2    : TypePtr;
  145.     Hold,
  146.     Lo, Hi    : Integer;
  147. begin
  148.     New(TP);
  149.     TP^.Object := ob_subrange;
  150.     Lo := ConExpr(IndexType1);
  151.     if not Match(DotDot1) then
  152.     error("expecting '..' here");
  153.     Hi := ConExpr(IndexType2);
  154.     if not TypeCmp(IndexType1, IndexType2) then begin
  155.     Error("Incompatible range types");
  156.     IndexType1 := BadType;
  157.     end;
  158.     if Lo > Hi then begin
  159.     Error("Lower bound greater than upper bound");
  160.     Hold := Hi;
  161.     Hi := Lo;
  162.     Lo := Hold;
  163.     end;
  164.     GetRange := AddType(ob_subrange, IndexType1, IndexType1,
  165.             Hi, Lo, IndexType1^.Size);
  166. end;
  167.  
  168. Function DeclArgs(ob : IDObject) : IDPtr;
  169.     forward;
  170.  
  171. Function ReadRecord(): TypePtr;
  172.  
  173. {
  174.     This just reads a record.
  175. }
  176. var
  177.     Size   : Integer;
  178.     TP     : TypePtr;
  179. begin
  180.     TP := AddType(ob_record, Nil, Nil, 0, 0, 0);
  181.     if TypeID <> Nil then
  182.     TypeID^.VType := TP;
  183.     TP^.Ref := DeclArgs(field);
  184.     if not match(end1) then
  185.     error("Missing END of record");
  186.     TP^.Size := ReformFields(TP^.Ref);
  187.     ReadRecord := TP;
  188. end;
  189.  
  190. Function ReadEnumeration(): TypePtr;
  191.  
  192. {
  193.     This just reads enumerations and assigns them numbers
  194. starting with zero.  The size of an enumerated type is either 1
  195. or two bytes: Enumerations with > 127 items are contained in 2.
  196. }
  197.  
  198. var
  199.     Position : Integer;
  200.     EnumType : TypePtr;
  201.     ID         : IDPtr;
  202. begin
  203.     Position := 0;
  204.     EnumType := AddType(ob_ordinal, Nil, Nil, 0, 0, 0);
  205.     While CurrSym = Ident1 do begin
  206.     if FindID(SymText) <> Nil then
  207.         Error("Duplicate ID");
  208.     ID := EnterStandard(SymText, constant, EnumType, st_none, Position);
  209.     Position := Succ(Position);
  210.     NextSymbol;
  211.     if CurrSym <> RightParent1 then
  212.         if not Match(Comma1) then
  213.         Error("Missing Comma");
  214.     end;
  215.     if Position <= 128 then    { Position = # of enumerations + 1 }
  216.     EnumType^.Size := 1
  217.     else
  218.     EnumType^.Size := 2;
  219.     NeedRightParent;
  220.     ReadEnumeration := EnumType;
  221. end;
  222.  
  223.     Function ReadType : TypePtr;
  224.     Forward;
  225.  
  226. Function DefineArray : TypePtr;
  227. var
  228.     TP, TP2,
  229.     LastType : TypePtr;
  230.     ID : IDPtr;
  231.  
  232.     Function DeclareDimension : TypePtr;
  233.     var
  234.     TP : TypePtr;
  235.     begin
  236.     TP := GetRange;
  237.     with TP^ do begin
  238.         Ref := SubType;
  239.         Object := ob_array;
  240.         if Match(Comma1) then
  241.         SubType := DeclareDimension
  242.         else
  243.         SubType := Nil;
  244.     end;
  245.     DeclareDimension := TP;
  246.     end;
  247.  
  248.     Procedure FixArraySize(TP : TypePtr);
  249.     begin
  250.     if TP^.Object = ob_array then begin
  251.         FixArraySize(TP^.SubType);
  252.         TP^.Size := TP^.SubType^.Size * (TP^.Upper - TP^.Lower + 1);
  253.     end;
  254.     end;
  255.  
  256. begin
  257.     if Match(LeftBrack1) then begin
  258.     TP := DeclareDimension;
  259.     LastType := TP;
  260.     While LastType^.SubType <> Nil do
  261.         LastType := LastType^.SubType;   { Get the last array dim }
  262.     if not Match(RightBrack1) then
  263.         error("Expecting a right bracket");
  264.     end else if CurrSym = Ident1 then begin
  265.     ID := FindID(SymText);
  266.     NextSymbol;
  267.     if ID = Nil then begin
  268.         error("Unknown ID");
  269.         TP := BadType;
  270.     end else if ID^.Object <> obtype then begin
  271.         error("Expecting a type");
  272.         TP := BadType;
  273.     end else if ID^.VType^.Object <> ob_subrange then begin
  274.         error("Expecting a range");
  275.         TP := BadType;
  276.     end else
  277.         TP := ID^.VType;
  278.     New(TP2);
  279.     TP2^ := TP^;
  280.     TP := TP2;
  281.     TP^.Next := CurrentBlock^.FirstType;
  282.     CurrentBlock^.FirstType := TP;
  283.     LastType := TP;
  284.     end else begin
  285.     error("Expecting range");
  286.     New(TP);
  287.     TP^ := BadType^;
  288.     LastType := TP;
  289.     end;
  290.     TP^.Object := ob_array;
  291.     if not match(of1) then
  292.     error("expecting OF");
  293.     LastType^.SubType := ReadType;
  294.     FixArraySize(TP);
  295.     DefineArray := TP;
  296. end;
  297.  
  298. Function ReadType(): TypePtr;
  299.  
  300. {
  301.     This is a bit of a monster function, but needs yet more
  302. stuff (like ranges).  The pointer part should have support for a
  303. pointer to an as-yet-unknown-id.  This routine returns the index of
  304. the type produced by the type declaration.  Note that I use the
  305. same routine almost wherever I need a type, which is why you can
  306. use a full type description most places.
  307. }
  308.  
  309. var
  310.     TP    : TypePtr;
  311.     ID  : IDPtr;
  312. begin
  313.     if currsym = ident1 then begin
  314.     ID := FindID(symtext);
  315.     if ID = Nil then begin
  316.         Error("Unknown ID");
  317.         TP := BadType;
  318.         NextSymbol;
  319.     end else if ID^.Object = obtype then begin
  320.         TP := ID^.VType;
  321.         NextSymbol;
  322.     end else if ID^.Object = constant then
  323.         TP := GetRange()
  324.     else begin
  325.         Error("Expecting a TYPE");
  326.         TP := BadType;
  327.         NextSymbol;
  328.     end;
  329.     end else if (CurrSym = Numeral1) or (CurrSym = Apostrophe1) then
  330.     TP := GetRange()
  331.     else if match(carat1) then begin
  332.     TP := ReadType();
  333.     TP := AddType(ob_pointer, TP, nil, 0, 0, 4);
  334.     end else if match(leftparent1) then
  335.     TP := ReadEnumeration()
  336.     else if match(array1) then
  337.     TP := DefineArray
  338.     else if match(record1) then begin
  339.     TP := ReadRecord();
  340.     end else if match(file1) then begin
  341.     if not match(of1) then
  342.         error("expecting OF");
  343.     TP := ReadType();
  344.     TP := AddType(ob_file, TP, nil, TP^.Size, 0, 32);
  345.     end else begin
  346.     error("unknown type of thing");
  347.     TP := BadType;
  348.     end;
  349.     readtype := TP;
  350. end;
  351.  
  352. Procedure DeclType;
  353.  
  354. {
  355.     This handles a type declaration block.
  356. }
  357. begin
  358.     While CurrSym = ident1 do begin
  359.     if CheckID(SymText) <> nil then
  360.         error("duplicate id");
  361.     TypeID := EnterStandard(SymText, obtype, BadType, st_none, 0);
  362.     NextSymbol;
  363.     if not Match(equal1) then
  364.         Error("expecting '=' here");
  365.     TypeID^.VType := ReadType();
  366.     ns;
  367.     end;
  368.     TypeID := Nil;
  369. end;
  370.  
  371. Function DeclArgs(ob : IDObject) : IDPtr;
  372.  
  373.     Procedure DeclArgList(var VarList : IDPtr; ob : IDObject);
  374.     var
  375.     ID,
  376.     RunID : IDPtr;
  377.     begin
  378.     if CurrSym = Ident1 then begin
  379.         if CheckIDList(SymText, VarList) then
  380.         error("Duplicate Parameter Name");
  381.         New(ID);
  382.         ID^.Name := EnterSpell(SymText);
  383.         ID^.Object := ob;
  384.         ID^.Next := Nil;
  385.         if VarList = Nil then
  386.         VarList := ID
  387.         else begin
  388.         RunID := VarList;
  389.         while RunID^.Next <> Nil do
  390.             RunID := RunID^.Next;
  391.         RunID^.Next := ID;
  392.          end;
  393.         NextSymbol;
  394.         if Match(Comma1) then begin
  395.         DeclArgList(VarList, ob);
  396.         ID^.VType := ID^.Next^.VType;
  397.         end else begin
  398.         if not Match(colon1) then
  399.             error("Expecting a colon");
  400.         ID^.VType := ReadType();
  401.         end;
  402.         if (ob = valarg) and (ID^.VType^.Object = ob_file) then
  403.         error("Files must be VAR parameters");
  404.     end;
  405.     end;
  406.  
  407. var
  408.     ID : IDPtr;
  409.  
  410. begin
  411.     ID := Nil;
  412.     if ob = field then begin
  413.     While CurrSym = Ident1 do begin
  414.         DeclArgList(ID, field);
  415.         ns;
  416.     end;
  417.     end else begin
  418.     while (CurrSym = Ident1) or (CurrSym = Var1) do begin
  419.         if Match(Var1) then
  420.         DeclArgList(ID, refarg)
  421.         else
  422.         DeclArgList(ID, valarg);
  423.         if CurrSym <> RightParent1 then
  424.         ns;
  425.     end;
  426.     end;
  427.     DeclArgs := ID;
  428. end;
  429.                     
  430. Function DeclVar(ob : IDObject) :  IDPtr;
  431.  
  432. {
  433.     This is used to declare a local or global variable.
  434. }
  435.  
  436. var
  437.     ID,
  438.     NextID : IDPtr;
  439.     TP    : TypePtr;
  440. begin
  441.     if currsym = ident1 then begin
  442.     if CheckID(symtext) <> Nil then
  443.         error("Duplicate id");
  444.     ID := EnterStandard(symtext, ob, BadType, StandardStorage, 0);
  445.     NextSymbol;
  446.     if match(comma1) then begin
  447.         NextID := DeclVar(ob);
  448.         ID^.VType := NextID^.VType;
  449.     end else begin
  450.         if not match(colon1) then
  451.         error("expecting :");
  452.         ID^.VType := ReadType();
  453.     end;
  454.     if ob = local then begin
  455.         StackSpace := StackSpace + ID^.VType^.Size;
  456.         if Odd(StackSpace) and (ID^.VTYpe^.Size <> 1) then
  457.         StackSpace := Succ(StackSpace);
  458.         ID^.Offset := -StackSpace;
  459.     end;
  460.     end else begin
  461.     error("expecting an identifier");
  462.     if CurrSym = Colon1 then
  463.         TP := ReadType()
  464.     else if match(colon1) then
  465.         TP := ReadType();
  466.     end;
  467.     DeclVar := ID;
  468. end;
  469.  
  470. Procedure VarDeclarations;
  471.  
  472. {
  473.     This handles a variable declaration block.
  474. }
  475. var
  476.     ID    : IDPtr;
  477. begin
  478.     While CurrSym = ident1 do begin
  479.     if CurrentBlock^.Level = 1 then begin
  480.         ID := DeclVar(global);
  481.         ns;
  482.     end else begin
  483.         ID := DeclVar(local);
  484.         ns;
  485.     end;
  486.     end;
  487. end;
  488.  
  489. Function TypedConstant(TP : TypePtr) : Integer;
  490. var
  491.     DefineIt : Boolean;
  492.  
  493.     Function TypedOrdinal(TP : TypePtr) : Integer;
  494.     var
  495.     ExprType : TypePtr;
  496.     ExprVal  : Integer;
  497.     begin
  498.     ExprVal := ConExpr(ExprType);
  499.     if DefineIt then
  500.         Writeln(OutFile, '\tdc.', Suffix(TP^.Size), '\t', ExprVal);
  501.     if not TypeCheck(ExprType, TP) then
  502.         Mismatch;
  503.     TypedOrdinal := ExprVal;
  504.     end;
  505.  
  506.     Function TypedArray(TP : TypePtr) : Integer;
  507.     var
  508.     ExprType : TypePtr;
  509.     ExprVal  : Integer;
  510.     Column   : Short;
  511.     Current  : Integer;
  512.     begin
  513.     if TypeCheck(TP^.SubType, CharType) then begin { special }
  514.         ExprVal := ConExpr(ExprType);
  515.         if not TypeCheck(ExprType, TP) then
  516.         MisMatch;
  517.         DumpLitQ(ExprVal);
  518.         LitPtr := ExprVal;
  519.         TypedArray := 1;
  520.     end else if TP^.SubType^.Object = ob_ordinal then begin
  521.         NeedLeftParent;
  522.         Column := 0;
  523.         if DefineIt then
  524.         Write(OutFile, '\tdc.', Suffix(TP^.SubType^.Size), '\t');
  525.         for Current := 1 to TP^.Upper - TP^.Lower + 1 do begin
  526.         ExprVal := ConExpr(ExprType);
  527.         if not TypeCheck(ExprType, TP^.SubType) then
  528.             Mismatch;
  529.         if DefineIt then begin
  530.             if Column > 60 then begin
  531.             Write(OutFile, '\n\tdc.', Suffix(TP^.SubType^.Size), '\t');
  532.             Column := 0;
  533.             end;
  534.             if Column > 0 then
  535.             Write(OutFile, ',');
  536.             Write(OutFile, ExprVal);
  537.             Column := Column + ExprType^.Size * 3;
  538.         end;
  539.         if CurrSym <> RightParent1 then
  540.             if not Match(Comma1) then
  541.             Error("Expecting a comma");
  542.         end;
  543.         if DefineIt then
  544.         Writeln(OutFile);
  545.         NeedRightParent;
  546.         TypedArray := 1;
  547.     end else begin
  548.         NeedLeftParent;
  549.         for Current := 1 to TP^.Upper - TP^.Lower + 1 do begin
  550.         ExprVal := TypedConstant(TP^.SubType);
  551.         if CurrSym <> RightParent1 then
  552.             if not match(Comma1) then
  553.             Error("Expecting a comma");
  554.         end;
  555.         NeedRightParent;
  556.         TypedArray := 1;
  557.     end;
  558.     end;
  559.  
  560.     Function TypedPointer(TP : TypePtr) : Integer;
  561.     var
  562.     ID : IDPtr;
  563.     ExprVal : Integer;
  564.     ExprType : TypePtr;
  565.     begin
  566.     if Match(At1) then begin
  567.         if CurrSym = Ident1 then begin
  568.         ID := FindID(SymText);
  569.         if (ID^.Object = Global) or
  570.            (ID^.Object = typed_const) then begin
  571.             if DefineIt then begin
  572.             if ID^.Level <= 1 then
  573.                 Writeln(OutFile, '\tdc.l\t_', ID^.Name)
  574.             else
  575.                 Writeln(OutFile, '\tdc.l\t_', ID^.Name,
  576.                         '%', ID^.Unique);
  577.             end;
  578.             if not TypeCheck(TP^.SubType, ID^.VType) then
  579.             MisMatch;
  580.         end else
  581.             Error("Expecting a global identifier");
  582.         NextSymbol;
  583.         end else
  584.         Error("Expecting an identifier");
  585.         TypedPointer := 1;
  586.     end else begin
  587.         ExprVal := ConExpr(ExprType);
  588.         if not TypeCheck(ExprType, TP) then
  589.         Mismatch;
  590.         if DefineIt then begin
  591.         if ExprType = StringType then begin
  592.             Write(OutFile, '\tdc.l\t');
  593.             PrintLabel(LitLab);
  594.             Writeln(OutFile, '+', ExprVal);
  595.         end else
  596.             Writeln(OutFile, '\tdc.l\t', ExprVal);
  597.         end else
  598.         LitPtr := ExprVal;
  599.         TypedPointer := ExprVal;
  600.     end;
  601.     end;
  602.  
  603.     Function TypedRecord(TP : TypePtr) : Integer;
  604.     var
  605.     ID : IDPtr;
  606.     ExprVal : Integer;
  607.     begin
  608.     NeedLeftParent;
  609.     ID := TP^.Ref;
  610.     while ID <> Nil do begin
  611.         ExprVal := TypedConstant(ID^.VType);
  612.         ID := ID^.Next;
  613.         if ID <> Nil then
  614.         if not Match(Comma1) then
  615.             Error("Expecting a comma");
  616.     end;
  617.     NeedRightParent;
  618.     TypedRecord := 1;
  619.     end;
  620.  
  621.     Function TypedReal : Integer;
  622.     var
  623.     ExprVal : Integer;
  624.     ExprType : TypePtr;
  625.     begin
  626.     ExprVal := ConExpr(ExprType);
  627.     if not TypeCheck(ExprType, RealType) then
  628.         MisMatch;
  629.     if DefineIt then begin
  630.         Write(OutFile, '\tdc.l\t');
  631.         WriteHex(ExprVal);
  632.         Writeln(OutFile);
  633.     end;
  634.     TypedReal := ExprVal;
  635.     end;
  636.  
  637. begin
  638.     DefineIt := StandardStorage <> st_external;
  639.     case TP^.Object of
  640.     ob_ordinal,
  641.     ob_subrange : TypedConstant := TypedOrdinal(TP);
  642.     ob_array   : TypedConstant := TypedArray(TP);
  643.     ob_pointer : TypedConstant := TypedPointer(TP);
  644.     ob_record  : TypedConstant := TypedRecord(TP);
  645.     ob_real    : TypedConstant := TypedReal;
  646.     else
  647.     Error("No typed constants allowed for this type");
  648.     end;
  649. end;
  650.  
  651. Procedure DeclConst;
  652.  
  653. {
  654.     This handles a const declaration block.  The grunt work is
  655. does by conexpr() in expression.p, which is the routine to look at
  656. if you want to improve constant declarations.
  657. }
  658. var
  659.     ID : IDPtr;
  660.     BackName : String;
  661.     TP : TypePtr;
  662. begin
  663.     While CurrSym = Ident1 do begin
  664.     if CheckID(SymText) <> Nil then
  665.         Error("Duplicate ID");
  666.     ID := EnterStandard(SymText, constant, Nil, st_none, 0);
  667.     BackName := ID^.Name;
  668.     ID^.Name := "";    { So the ID can't be used in the expression }
  669.     NextSymbol;
  670.     if Match(Colon1) then begin
  671.         ID^.VType := ReadType;
  672.         if not Match(Equal1) then
  673.         Error("Missing =");
  674.         if StandardStorage <> st_external then begin
  675.         if ID^.VType^.Size > 1 then
  676.             Writeln(OutFile, '\tCNOP\t0,2');
  677.         if CurrentBlock^.Level <= 1 then begin
  678.             if StandardStorage <> st_private then
  679.             Writeln(OutFile, '\tXDEF\t_', BackName);
  680.             writeln(OutFile, '_', BackName)
  681.         end else begin
  682.             ID^.Unique := GetLabel;
  683.             writeln(OutFile, '_', BackName, '%', ID^.Unique);
  684.         end;
  685.         end;
  686.         ID^.Offset := TypedConstant(ID^.VType);
  687.         ID^.Name := BackName;
  688.         ID^.Object := typed_const;
  689.         if StandardStorage <> st_external then
  690.         ID^.Storage := st_initialized
  691.         else
  692.         ID^.Storage := st_external;
  693.     end else begin
  694.         if not Match(Equal1) then
  695.         Error("Expecting =");
  696.         ID^.Offset := ConExpr(TP);
  697.         ID^.VType := TP;
  698.         ID^.Name := BackName;
  699.     end;
  700.     ns;
  701.     end;
  702. end;
  703.  
  704. Procedure DeclLabel;
  705. {
  706.     This routine accepts a list of identifiers to be used as
  707.     labels in the program.  Standard Pascal's labels are four
  708.     digit numbers, but I didn't want to mess with that.
  709. }
  710. var
  711.     ID : IDPtr;
  712. begin
  713.     while CurrSym = Ident1 do begin
  714.     ID := EnterStandard(SymText, lab, Nil, st_none, 0);
  715.     ID^.Unique := GetLabel;
  716.     NextSymbol;
  717.     if not Match(Comma1) then begin
  718.         ns;
  719.         return;
  720.     end;
  721.     end;
  722.     Error("Expecting an identifier");
  723. end;
  724.